home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form frmMail
- BorderStyle = 3 'Fixed Dialog
- Caption = "Simple Internet Mail..."
- ClientHeight = 6375
- ClientLeft = 945
- ClientTop = 1500
- ClientWidth = 8370
- Height = 6780
- Icon = "frmMail.frx":0000
- Left = 885
- LinkTopic = "Form1"
- LockControls = -1 'True
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 6375
- ScaleWidth = 8370
- ShowInTaskbar = 0 'False
- Top = 1155
- Width = 8490
- Begin TabDlg.SSTab SSTab1
- Height = 5655
- Left = 30
- TabIndex = 6
- Top = 420
- Width = 8355
- _Version = 65536
- _ExtentX = 14737
- _ExtentY = 9975
- _StockProps = 15
- Caption = "Connection Settings"
- TabsPerRow = 3
- Tab = 0
- TabOrientation = 0
- Tabs = 3
- Style = 1
- TabMaxWidth = 0
- TabHeight = 423
- TabCaption(0) = "Connection Settings"
- Tab(0).ControlCount= 8
- Tab(0).ControlEnabled= -1 'True
- Tab(0).Control(0)= "Label1(0)"
- Tab(0).Control(1)= "Label1(1)"
- Tab(0).Control(2)= "Label1(2)"
- Tab(0).Control(3)= "Label1(3)"
- Tab(0).Control(4)= "txtPopServer"
- Tab(0).Control(5)= "txtUserID"
- Tab(0).Control(6)= "txtPassword"
- Tab(0).Control(7)= "txtSmtpServer"
- TabCaption(1) = "Receive Mail"
- Tab(1).ControlCount= 17
- Tab(1).ControlEnabled= 0 'False
- Tab(1).Control(0)= "Label1(15)"
- Tab(1).Control(1)= "Label1(14)"
- Tab(1).Control(2)= "Label1(13)"
- Tab(1).Control(3)= "Label1(12)"
- Tab(1).Control(4)= "Label1(10)"
- Tab(1).Control(5)= "Label1(8)"
- Tab(1).Control(6)= "Label1(9)"
- Tab(1).Control(7)= "lblFirst"
- Tab(1).Control(8)= "Label1(11)"
- Tab(1).Control(9)= "lblLast"
- Tab(1).Control(10)= "txtPOPSubject"
- Tab(1).Control(11)= "txtPOPCc"
- Tab(1).Control(12)= "txtPOPTo"
- Tab(1).Control(13)= "txtPOPReceived"
- Tab(1).Control(14)= "txtPOPFrom"
- Tab(1).Control(15)= "txtDownload"
- Tab(1).Control(16)= "txtMessageID"
- TabCaption(2) = "Send Mail"
- Tab(2).ControlCount= 9
- Tab(2).ControlEnabled= 0 'False
- Tab(2).Control(0)= "txtSubject"
- Tab(2).Control(1)= "txtFrom"
- Tab(2).Control(2)= "txtCc"
- Tab(2).Control(3)= "txtTo"
- Tab(2).Control(4)= "txtSendBody"
- Tab(2).Control(5)= "Label1(7)"
- Tab(2).Control(6)= "Label1(6)"
- Tab(2).Control(7)= "Label1(5)"
- Tab(2).Control(8)= "Label1(4)"
- Begin VB.TextBox txtSmtpServer
- Height = 285
- Left = 1665
- TabIndex = 3
- Top = 1530
- Width = 3030
- End
- Begin VB.TextBox txtPassword
- Height = 285
- Left = 1665
- PasswordChar = "*"
- TabIndex = 2
- Top = 930
- Width = 3030
- End
- Begin VB.TextBox txtUserID
- Height = 285
- Left = 1665
- TabIndex = 1
- Top = 630
- Width = 3030
- End
- Begin VB.TextBox txtPopServer
- Height = 285
- Left = 1665
- TabIndex = 0
- Top = 330
- Width = 3030
- End
- Begin VB.TextBox txtMessageID
- Height = 285
- Left = -67380
- TabIndex = 17
- Top = 610
- Width = 630
- End
- Begin VB.TextBox txtDownload
- Height = 3780
- Left = -74970
- MultiLine = -1 'True
- ScrollBars = 3 'Both
- TabIndex = 16
- TabStop = 0 'False
- Top = 1810
- Width = 8235
- End
- Begin VB.TextBox txtPOPFrom
- Height = 285
- Left = -74070
- TabIndex = 13
- TabStop = 0 'False
- Top = 910
- Width = 5430
- End
- Begin VB.TextBox txtPOPReceived
- Height = 285
- Left = -74070
- TabIndex = 14
- TabStop = 0 'False
- Top = 1210
- Width = 5430
- End
- Begin VB.TextBox txtPOPTo
- Height = 285
- Left = -74070
- TabIndex = 11
- TabStop = 0 'False
- Top = 310
- Width = 5430
- End
- Begin VB.TextBox txtPOPCc
- Height = 285
- Left = -74070
- TabIndex = 12
- TabStop = 0 'False
- Top = 610
- Width = 5430
- End
- Begin VB.TextBox txtPOPSubject
- Height = 285
- Left = -74070
- TabIndex = 15
- TabStop = 0 'False
- Top = 1510
- Width = 7320
- End
- Begin VB.TextBox txtSubject
- Height = 285
- Left = -74070
- TabIndex = 25
- Top = 1245
- Width = 5430
- End
- Begin VB.TextBox txtFrom
- Height = 315
- Left = -74070
- TabIndex = 23
- Top = 915
- Width = 5430
- End
- Begin VB.TextBox txtCc
- Height = 285
- Left = -74070
- TabIndex = 21
- Top = 615
- Width = 5430
- End
- Begin VB.TextBox txtTo
- Height = 285
- Left = -74070
- TabIndex = 19
- Top = 315
- Width = 5430
- End
- Begin VB.TextBox txtSendBody
- Height = 4050
- Left = -74940
- MultiLine = -1 'True
- ScrollBars = 3 'Both
- TabIndex = 27
- Top = 1545
- Width = 8235
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "SMTP &Server:"
- Height = 195
- Index = 3
- Left = 600
- TabIndex = 36
- Top = 1575
- Width = 1005
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "Password:"
- Height = 195
- Index = 2
- Left = 885
- TabIndex = 35
- Top = 975
- Width = 750
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "User ID:"
- Height = 195
- Index = 1
- Left = 1035
- TabIndex = 34
- Top = 675
- Width = 585
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "POP Server:"
- Height = 195
- Index = 0
- Left = 750
- TabIndex = 33
- Top = 375
- Width = 885
- End
- Begin VB.Label lblLast
- BorderStyle = 1 'Fixed Single
- Caption = "0"
- Height = 285
- Left = -67380
- TabIndex = 32
- Top = 915
- Width = 630
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "Last Msg Id:"
- Height = 195
- Index = 11
- Left = -68265
- TabIndex = 31
- Top = 955
- Width = 870
- End
- Begin VB.Label lblFirst
- BorderStyle = 1 'Fixed Single
- Caption = "0"
- Height = 285
- Left = -67380
- TabIndex = 30
- Top = 315
- Width = 630
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "First Msg Id:"
- Height = 195
- Index = 9
- Left = -68250
- TabIndex = 29
- Top = 355
- Width = 855
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "Current:"
- Height = 195
- Index = 8
- Left = -67950
- TabIndex = 28
- Top = 655
- Width = 555
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "From:"
- Height = 195
- Index = 10
- Left = -74505
- TabIndex = 26
- Top = 955
- Width = 405
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "Received:"
- Height = 195
- Index = 12
- Left = -74835
- TabIndex = 24
- Top = 1255
- Width = 750
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "To:"
- Height = 195
- Index = 13
- Left = -74355
- TabIndex = 22
- Top = 355
- Width = 240
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "Cc:"
- Height = 195
- Index = 14
- Left = -74370
- TabIndex = 20
- Top = 655
- Width = 225
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "Subject:"
- Height = 195
- Index = 15
- Left = -74670
- TabIndex = 18
- Top = 1555
- Width = 570
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "Su&bject:"
- Height = 195
- Index = 7
- Left = -74670
- TabIndex = 10
- Top = 1275
- Width = 585
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "&From:"
- Height = 195
- Index = 6
- Left = -74490
- TabIndex = 9
- Top = 945
- Width = 390
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "&Cc:"
- Height = 195
- Index = 5
- Left = -74340
- TabIndex = 8
- Top = 645
- Width = 240
- End
- Begin VB.Label Label1
- AutoSize = -1 'True
- Caption = "&To:"
- Height = 195
- Index = 4
- Left = -74340
- TabIndex = 7
- Top = 345
- Width = 240
- End
- End
- Begin ComctlLib.StatusBar Status
- Align = 2 'Align Bottom
- Height = 285
- Left = 0
- TabIndex = 5
- Top = 6090
- Width = 8370
- _Version = 65536
- _ExtentX = 14774
- _ExtentY = 508
- _StockProps = 68
- AlignSet = -1 'True
- SimpleText = ""
- NumPanels = 3
- i1 = "frmMail.frx":014A
- i2 = "frmMail.frx":0238
- i3 = "frmMail.frx":0326
- End
- Begin POPCTLib.POPCT POP
- Left = 8490
- Top = 1110
- _ExtentX = 847
- _ExtentY = 847
- RemoteHost = "127.0.0.1"
- RemotePort = 110
- ConnectTimeout = 0
- RecvTimeout = 0
- NotificationMode= 1
- UserId = ""
- Password = ""
- TopLines = 0
- End
- Begin SMTPCTLib.smtpct SMTP
- Left = 8490
- Top = 1650
- _ExtentX = 847
- _ExtentY = 847
- RemoteHost = "mail"
- RemotePort = 25
- ConnectTimeout = 0
- RecvTimeout = 0
- NotificationMode= 0
- End
- Begin ComctlLib.Toolbar Tools
- Align = 1 'Align Top
- Height = 390
- Left = 0
- TabIndex = 4
- Top = 0
- Width = 8370
- _Version = 65536
- _ExtentX = 14764
- _ExtentY = 688
- _StockProps = 96
- ImageList = "Images"
- NumButtons = 8
- i1 = "frmMail.frx":0432
- i2 = "frmMail.frx":05D1
- i3 = "frmMail.frx":0784
- i4 = "frmMail.frx":095B
- i5 = "frmMail.frx":0AFA
- i6 = "frmMail.frx":0CC5
- i7 = "frmMail.frx":0E6C
- i8 = "frmMail.frx":100B
- AlignSet = -1 'True
- End
- Begin ComctlLib.ImageList Images
- Left = 8430
- Top = 2220
- _Version = 65536
- _ExtentX = 1005
- _ExtentY = 1005
- _StockProps = 1
- BackColor = -2147483643
- ImageWidth = 16
- ImageHeight = 16
- MaskColor = 12632256
- NumImages = 5
- i1 = "frmMail.frx":11DA
- i2 = "frmMail.frx":1599
- i3 = "frmMail.frx":1958
- i4 = "frmMail.frx":1B57
- i5 = "frmMail.frx":1D56
- End
- Attribute VB_Name = "frmMail"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- '---------------------------------------------------------------
- ' [Tools.Buttons collection button index constants...]
- '---------------------------------------------------------------
- Const btnPOPCONNECT = 2 ' POP connect button
- Const btnPOPDISCONNECT = 3 ' POP disconnect button
- Const btnPOPRECEIVE = 5 ' POP receive button
- Const btnSMTPSEND = 6 ' SMTP send button
- Const btnPOPREFRESH = 8 ' POP refresh button...
- '---------------------------------------------------------------
- Private Sub POP_Authenticate()
- '---------------------------------------------------------------
- Dim Count As Long ' Message count variable...
- '---------------------------------------------------------------
- Count = POP.MessageCount ' Get message count from Pop server
- If (Count > 0) Then ' If messages available then...
- lblFirst.Caption = "1" ' Update ui
- lblLast.Caption = Format(Count, "0") ' ...
- txtMessageId.Text = "1" ' ...
- Else ' no messages
- lblFirst.Caption = "0" ' show all 0's
- lblLast.Caption = "0" '
- txtMessageId.Text = "" '
- End If
- '---------------------------------------------------------------
- End Sub
- '---------------------------------------------------------------
- '---------------------------------------------------------------
- Private Sub POP_DocOutput(ByVal DocOutput As DocOutput)
- '---------------------------------------------------------------
- Dim msg As Variant ' GetData output variable
- Dim Hdr As DocHeader ' Header object variable
- '---------------------------------------------------------------
- Select Case DocOutput.State ' Determine current download state
- Case icDocBegin ' [Beginning download - no data yet...]
- Status.Panels.Item(3).Text = "POP3: Download Started." ' Update status
- txtDownload.Text = "" ' Clear text boxes...
- txtPOPFrom.Text = ""
- txtPOPReceived.Text = ""
- txtPOPTo.Text = ""
- txtPOPCc.Text = ""
- txtPOPSubject.Text = ""
- Case icDocHeaders ' [Downloading MIME-headers - only in headers collection]
- Status.Panels.Item(3).Text = "POP3: Downloading Headers...[" & _
- CStr(DocOutput.Headers.Count) & "]" ' Update status
- For Each Hdr In DocOutput.Headers ' look at each header in the headers collection
- Select Case LCase(Hdr.Name) ' determine MIME-Header type...
- Case "from" ' MIME-type: From
- txtPOPFrom.Text = Hdr.Value
- Case "date" ' MIME-type: Date
- txtPOPReceived.Text = Hdr.Value
- Case "to" ' MIME-type: To
- txtPOPTo.Text = Hdr.Value
- Case "cc" ' MIME-type: Cc
- txtPOPCc.Text = Hdr.Value
- Case "subject" ' MIME-type: Subject
- txtPOPSubject.Text = Hdr.Value
- Case Else ' MIME-type: etc...
- txtDownload.Text = txtDownload.Text & _
- Hdr.Name & ": " & Hdr.Value & vbCrLf ' Stick the rest into the message body
- End Select
- Next ' Get next header
- Case icDocData ' [Downloading data - message body...]
- DocOutput.GetData msg ' Get data from DocOutput object
- Status.Panels.Item(3).Text = "POP3: Downloading Data..." ' Update status
- txtDownload.Text = txtDownload.Text & msg ' Add message to text box
- Case icDocEnd ' [Data Download Complete]
- Status.Panels.Item(3).Text = "POP3: Download Complete." ' Update status
- Case icDocError ' [Error in download.]
- Status.Panels.Item(3).Text = "POP3: Download Error." ' Update status
- Case icDocNone ' [???]
- End Select
- '---------------------------------------------------------------
- End Sub
- '---------------------------------------------------------------
- '---------------------------------------------------------------
- Private Sub POP_StateChanged(ByVal State As Integer)
- '---------------------------------------------------------------
- Tools.Buttons(btnPOPDISCONNECT).Enabled = (State <> prcDisconnected) ' Enable disconnect if not disconnected
- Tools.Buttons(btnPOPRECEIVE).Enabled = (State = prcConnected) ' Enable pop receive button if connected
- Status.Panels.Item(1).Text = "POP3: " & POP.StateString ' Update status
- '---------------------------------------------------------------
- End Sub
- '---------------------------------------------------------------
- '---------------------------------------------------------------
- Private Sub POP_ProtocolStateChanged(ByVal ProtocolState As Integer)
- '---------------------------------------------------------------
- Tools.Buttons(btnPOPREFRESH).Enabled = (ProtocolState = prcTransaction) ' Enable pop refresh if connected and validated only...
- Status.Panels.Item(2).Text = "POP3: " & POP.ProtocolStateString ' update status
- Select Case ProtocolState ' Determine current POP protocol state
- Case prcNone ' ?
- Case prcAuthorization ' POP protocol requesting authentication from client...
- POP.Authenticate txtUserID.Text, txtPassword.Text ' Send authentication...
- Case prcTransaction ' POP protocol ready for transactions...
- Case prcUpdate ' POP protocol is currently changing
- End Select
- '---------------------------------------------------------------
- End Sub
- '---------------------------------------------------------------
- '---------------------------------------------------------------
- Private Sub SMTP_DocInput(ByVal DocInput As DocInput)
- '---------------------------------------------------------------
- Select Case DocInput.State ' Determine current state of DocInput transaction
- Case icDocBegin ' [Beginning transaction to SMTP server]
- Status.Panels.Item(3).Text = "SMTP: Send Start."
- Case icDocHeaders ' [Sending headers to SMTP server]
- Status.Panels.Item(3).Text = "SMTP: Sending Headers..."
- Case icDocData ' [Sending data to SMTP serve]
- Status.Panels.Item(3).Text = "SMTP: Sending Data..."
- Case icDocEnd ' [End of transaction]
- Status.Panels.Item(3).Text = "SMTP: Send Complete."
- Case icDocError ' [Error in transaction]
- Status.Panels.Item(3).Text = "SMTP: Send Error."
- Case icDocNone '[?]
- End Select
- '---------------------------------------------------------------
- End Sub
- '---------------------------------------------------------------
- Private Sub SMTP_StateChanged(ByVal State As Integer)
- Status.Panels.Item(1).Text = "SMTP: " & SMTP.StateString ' Update status
- End Sub
- Private Sub SMTP_ProtocolStateChanged(ByVal ProtocolState As Integer)
- Status.Panels.Item(2).Text = "SMTP: " & SMTP.ProtocolStateString ' Update status
- End Sub
- '------------------------------------------------------------
- Private Sub Tools_ButtonClick(ByVal Button As Button)
- '------------------------------------------------------------
- Dim HDRs As DocHeaders ' DocHeaders collection used to send mail message to SMTP server
- Dim Count As Long ' POP message count variable
- '------------------------------------------------------------
- Select Case Button.Index ' Determine the button that was clicked on tool bar
- Case btnPOPCONNECT ' [POP Connect]
- POP.Connect txtPopServer.Text ' Connect to server
- Case btnPOPDISCONNECT ' [POP Disconnect]
- POP.Quit ' Disconnect from server
- Case btnPOPRECEIVE ' [POP Receive]
- POP.RetrieveMessage Val(txtMessageId.Text) ' Download\Receive mail message
- Case btnSMTPSEND ' [SMTP Send]
- SMTP.RemoteHost = txtSmtpServer.Text ' Set name of SMTP server to RemoteHost
-
- Set HDRs = SMTP.DocInput.Headers ' Copy SMTP DocInputHeaders collection
- HDRs.Clear ' Clear headers collection
- HDRs.Add "To", txtTo.Text ' Add... MIME-header: To
- HDRs.Add "CC", txtCc.Text ' Add... MIME-header: Cc
- HDRs.Add "From", txtFrom.Text ' Add... MIME-header: From
- HDRs.Add "Subject", txtSubject.Text ' Add... MIME-header: Subject
- HDRs.Add "Message-Id", "<" & App.Title & _
- "." & Format(Date) & _
- "." & Format(Timer) & _
- "." & txtFrom.Text & ">" ' Add... MIME-header: Message-Id
-
- HDRs.Add "Content-Type", "TEXT/PLAIN; charset=US-ASCII" ' Add... MIME-header: Content-Type
- HDRs.Add "Content-Length", " " & Len(txtSendBody.Text) + 2 ' Add... MIME-header: Content-Length
-
- SMTP.SendDoc , HDRs, txtSendBody.Text ' Send mail to SMTP server
- Case btnPOPREFRESH ' Tell POP server to reset info
- POP.Reset ' Call reset
- Count = POP.MessageCount ' Get current POP remote mail count
-
- If (Count > 0) Then ' If any messages exist...
- lblFirst.Caption = "1" ' Update UI
- lblLast.Caption = Format(Count, "0")
- txtMessageId.Text = "1"
- Else ' Else no messages exist
- lblFirst.Caption = "0" ' Update UI...
- lblLast.Caption = "0"
- txtMessageId.Text = ""
- End If
- End Select
- '------------------------------------------------------------
- End Sub
- '------------------------------------------------------------
-